The following objects are masked from 'package:base':
as.Date, as.Date.numeric
Loading required package: TTR
Registered S3 method overwritten by 'quantmod':
method from
as.zoo.data.frame zoo
library(dplyr)
######################### Warning from 'xts' package ##########################
# #
# The dplyr lag() function breaks how base R's lag() function is supposed to #
# work, which breaks lag(my_xts). Calls to lag(my_xts) that you type or #
# source() into this session won't work correctly. #
# #
# Use stats::lag() to make sure you're not using dplyr::lag(), or you can add #
# conflictRules('dplyr', exclude = 'lag') to your .Rprofile to stop #
# dplyr from breaking base R's lag() function. #
# #
# Code in packages is not affected. It's protected by R's namespace mechanism #
# Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning. #
# #
###############################################################################
Attaching package: 'dplyr'
The following objects are masked from 'package:xts':
first, last
The following objects are masked from 'package:stats':
filter, lag
The following objects are masked from 'package:base':
intersect, setdiff, setequal, union
library(lubridate)
Attaching package: 'lubridate'
The following objects are masked from 'package:base':
date, intersect, setdiff, union
library(plotly)
Loading required package: ggplot2
Attaching package: 'plotly'
The following object is masked from 'package:ggplot2':
last_plot
The following object is masked from 'package:stats':
filter
The following object is masked from 'package:graphics':
layout
# Function to calculate weekly returns indexed to start of yearcalculate_weekly_returns <-function(symbol, start_date, end_date) { data <-getSymbols(symbol, from = start_date, to = end_date, src ="yahoo", auto.assign =FALSE) prices <-Ad(data) df <-data.frame(date =index(prices), price =as.numeric(prices)) df <- df %>%mutate(year =year(date),week =week(date)) %>%group_by(year, week) %>%summarise(date =last(date), price =last(price), .groups ='drop') %>%arrange(date) df <- df %>%group_by(year) %>%mutate(pct_change = (price /first(price) -1) *100) %>%filter(week <=52) %>%ungroup()return(df)}# Set date rangeend_date <-Sys.Date()start_date <-as.Date("2008-01-01")start_year <-as.integer(format(start_date, "%Y"))# Calculate weekly returns for NASDAQ - MAKE SURE THIS IS EXECUTEDnasdaq_returns <-calculate_weekly_returns("^IXIC", start_date, end_date)# Split data into dataframesdf_historical <- nasdaq_returns %>%filter(year >= start_year & year <=2024)df_2025 <- nasdaq_returns %>%filter(year ==2025)df_avg_historical <- df_historical %>%group_by(week) %>%summarise(avg_pct_change =mean(pct_change, na.rm =TRUE))# Create the plotp <-plot_ly()# Add traces for historical datap <-add_trace(p, x =~week, y =~pct_change, data = df_historical,type ='scatter', mode ='lines', split =~year,line =list(color ='grey', width =1),opacity =0.3,hoverinfo ="text",text =~paste("Year:", year, "<br>Week:", week, "<br>Change:", round(pct_change, 2), "%"),showlegend =FALSE)# Add a custom trace for the historical legend entryp <-add_trace(p, x =c(1), y =c(NA), type ='scatter', mode ='lines',line =list(color ='grey', width =1),opacity =0.3,name ='',hoverinfo ='none')# Add trace for 2025if(nrow(df_2025) >0) { p <-add_trace(p, x =~week, y =~pct_change, data = df_2025,type ='scatter', mode ='lines',line =list(color ='#336699', width =2),name ='2025',hoverinfo ="text",text =~paste("Year: 2025<br>Week:", week, "<br>Change:", round(pct_change, 2), "%"))}# Add trace for average of historical datap <-add_trace(p, x =~week, y =~avg_pct_change, data = df_avg_historical,type ='scatter', mode ='lines',opacity =1,line =list(color ='darkred', width =2, dash ='dot'),name =paste0("Average (",start_year,"-2024)"),hoverinfo ="text",text =~paste0("Year: Average (",start_year,"-2024)<br>Week:", week, "<br>Change:", round(avg_pct_change, 2), "%"))# Update layoutp <- p %>%layout(xaxis =list(title ="Week", range =c(1, 52),showgrid =FALSE,tickmode ="array",tickvals =c(1, 10, 20, 30, 40, 50),ticktext =c("1", "10", "20", "30", "40", "50") ),yaxis =list(title ="% Change"),showlegend =TRUE,legend =list(orientation ="h", y =1.1),hovermode ="closest") %>%config(displayModeBar =FALSE)# Add the highlight effectp <- p %>%highlight(on ="plotly_hover",off ="plotly_doubleclick", # Changed from "plotly_unhover" to a valid optionselected =list(line =list(color ="black", width =3)),opacityDim =0.2 )# Display the plotp